unit net;

interface

uses
  WinSock,
  Winsock2,
  mongo;

function mongo_close_socket(sock: TSocket): Integer; inline;

function mongo_set_socket_op_timeout(var conn: TMongo; millis: Integer): Integer;
function mongo_read_socket(var conn: TMongo; buf: PByte; len: Integer): Integer;
function mongo_write_socket(var conn: TMongo; buf: PByte; len: Integer): Integer;
function mongo_socket_connect(var conn: TMongo; host: string; port: Integer): Integer;

implementation

uses
  Windows,
  SysUtils;

type
  PADDRINFO = ^ADDRINFO;
  PPADDRINFO = ^PADDRINFO;
  ADDRINFO = record
    ai_flags        : Integer;      // AI_PASSIVE, AI_CANONNAME, AI_NUMERICHOST
    ai_family       : Integer;      // PF_xxx
    ai_socktype     : Integer;      // SOCK_xxx
    ai_protocol     : Integer;      // 0 or IPPROTO_xxx for IPv4 and IPv6
    ai_addrlen      : ULONG;        // Length of ai_addr
    ai_canonname    : PAnsiChar;    // Canonical name for nodename
    ai_addr         : PSOCKADDR;    // Binary address
    ai_next         : PAddrInfo;    // Next structure in linked list
  end;

  PADDRINFOW = ^ADDRINFOW;
  PPADDRINFOW = ^PADDRINFOW;
  ADDRINFOW = record
    ai_flags        : Integer;      // AI_PASSIVE, AI_CANONNAME, AI_NUMERICHOST
    ai_family       : Integer;      // PF_xxx
    ai_socktype     : Integer;      // SOCK_xxx
    ai_protocol     : Integer;      // 0 or IPPROTO_xxx for IPv4 and IPv6
    ai_addrlen      : ULONG;        // Length of ai_addr
    ai_canonname    : PWideChar;    // Canonical name for nodename
    ai_addr         : PSOCKADDR;    // Binary address
    ai_next         : PAddrInfoW;   // Next structure in linked list
  end;

  LPFN_GETADDRINFO = function(NodeName: PAnsiChar; ServiceName: PAnsiChar; Hints: PADDRINFO; ppResult: PPADDRINFO): Integer; stdcall;
  LPFN_GETADDRINFOW = function(NodeName: PWideChar; ServiceName: PWideChar; Hints: PADDRINFOW; ppResult: PPADDRINFOW): Integer; stdcall;
  LPFN_FREEADDRINFO = procedure(ai: PADDRINFO); stdcall;
  LPFN_FREEADDRINFOW = procedure(ai: PADDRINFOW); stdcall;

var
  WS2_32Handle: HMODULE;
  getaddrinfo: LPFN_GETADDRINFO = nil;
  GetAddrInfoW: LPFN_GETADDRINFOW = nil;
  freeaddrinfo: LPFN_FREEADDRINFO = nil;
  FreeAddrInfoW: LPFN_FREEADDRINFOW = nil;

procedure _mongo_initialize_funcs;
begin
  WS2_32Handle := LoadLibrary('WS2_32.DLL');
  if WS2_32Handle <> 0 then begin
    GetAddrInfoW := GetProcAddress(WS2_32Handle, 'GetAddrInfoW');
    FreeAddrInfoW := GetProcAddress(WS2_32Handle, 'FreeAddrInfoW');
    if (not Assigned(GetAddrInfoW)) or (not Assigned(FreeAddrInfoW)) then begin
      GetAddrInfoW := nil;
      FreeAddrInfoW := nil;
      getaddrinfo := GetProcAddress(WS2_32Handle, 'getaddrinfo');
      freeaddrinfo := GetProcAddress(WS2_32Handle, 'freeaddrinfo');
    end;
  end;
end;

procedure _mongo_finalize_funcs;
begin
  if WS2_32Handle <> 0 then
    FreeLibrary(WS2_32Handle);
  GetAddrInfoW := nil;
  FreeAddrInfoW := nil;
  getaddrinfo := nil;
  freeaddrinfo := nil;
end;

function _mongo_create_socket(var conn: TMongo): Integer;
var
  fd: TSocket;
begin
  fd := socket(AF_INET, SOCK_STREAM, 0);
  if fd = INVALID_SOCKET then begin
    conn.err := meMongoConnNoSocket;
    Exit(MONGO_ERROR);
  end;
  conn.sock := fd;

  Result := MONGO_OK;
end;

function mongo_close_socket(sock: TSocket): Integer; inline;
begin
  Result := closesocket(sock);
end;

function mongo_set_socket_op_timeout(var conn: TMongo; millis: Integer): Integer;
var
  tv: TTimeVal;
begin
  tv.tv_sec := millis div 1000;
  tv.tv_usec := (millis mod 1000) * 1000;

  if setsockopt(conn.sock, SOL_SOCKET, SO_RCVTIMEO, @tv, SizeOf(tv)) = SOCKET_ERROR then begin
    conn.err := meMongoIOError;
    Exit(MONGO_ERROR);
  end;

  if setsockopt(conn.sock, SOL_SOCKET, SO_SNDTIMEO, @tv, SizeOf(tv)) = SOCKET_ERROR then begin
    conn.err := meMongoIOError;
    Exit(MONGO_ERROR);
  end;

  Result := MONGO_OK;
end;

function mongo_read_socket(var conn: TMongo; buf: PByte; len: Integer): Integer;
var
  sent: Integer;
begin
  while len > 0 do begin
    sent := recv(conn.sock, buf^, len, 0);
    if (sent = 0) or (sent = SOCKET_ERROR) then begin
      conn.err := meMongoIOError;
      Exit(MONGO_ERROR);
    end;
    Inc(buf, sent);
    Dec(len, sent);
  end;

  Result := MONGO_OK;
end;

function mongo_write_socket(var conn: TMongo; buf: PByte; len: Integer): Integer;
var
  sent: Integer;
begin
  while len > 0 do begin
    sent := send(conn.sock, buf^, len, 0);
    if sent = SOCKET_ERROR then begin
      conn.err := meMongoIOError;
      Exit(MONGO_ERROR);
    end;
    Inc(buf, sent);
    Dec(len, sent);
  end;

  Result := MONGO_OK;
end;

function mongo_socket_connect(var conn: TMongo; host: string; port: Integer): Integer;
var
  hints: ADDRINFO;
  hintsW: ADDRINFOW;
  addrs: PADDRINFO;
  addrsW: PADDRINFOW;
  flag: BOOL;
begin
  flag := True;

  conn.sock := 0;
  conn.connected := False;

  if Assigned(GetAddrInfoW) then begin
    FillChar(hintsW, 0, SizeOf(hintsW));
    hintsW.ai_family := AF_INET;
    hintsW.ai_socktype := SOCK_STREAM;
  end
  else begin
    FillChar(hints, 0, SizeOf(hints));
    hints.ai_family := AF_INET;
    hints.ai_socktype := SOCK_STREAM;
  end;

  if _mongo_create_socket(conn) <> MONGO_OK then
    Exit(MONGO_ERROR);

  if Assigned(GetAddrInfoW) then begin
    if GetAddrInfoW(PWideChar(host), PWideChar(IntToStr(port)), @hintsW, @addrsW) <> 0 then begin
      conn.errstr := SysErrorMessage(WSAGetLastError);
      conn.err := meMongoConnAddrFail;
      Exit(MONGO_ERROR);
    end;
    if connect(conn.sock, addrsW^.ai_addr^, addrsW^.ai_addrlen) = -1 then begin
      mongo_close_socket(conn.sock);
      FreeAddrInfoW(addrsW);
      conn.err := meMongoConnFail;
      Exit(MONGO_ERROR);
    end;
  end
  else begin
    if GetAddrInfo(PAnsiChar(AnsiString(host)), PAnsiChar(AnsiString(IntToStr(port))), @hints, @addrs) <> 0 then begin
      conn.errstr := SysErrorMessage(WSAGetLastError);
      conn.err := meMongoConnAddrFail;
      Exit(MONGO_ERROR);
    end;
    if connect(conn.sock, addrs^.ai_addr^, addrs^.ai_addrlen) = -1 then begin
      mongo_close_socket(conn.sock);
      freeaddrinfo(addrs);
      conn.err := meMongoConnFail;
      Exit(MONGO_ERROR);
    end;
  end;

  setsockopt(conn.sock, IPPROTO_TCP, TCP_NODELAY, @flag, SizeOf(flag));
  if conn.op_timeout_ms > 0 then
    mongo_set_socket_op_timeout(conn, conn.op_timeout_ms);

  conn.connected := True;
  if Assigned(GetAddrInfoW) then
    FreeAddrInfoW(addrsW)
  else
    freeaddrinfo(addrs);

  Result := MONGO_OK;
end;

initialization
  _mongo_initialize_funcs;

finalization
  _mongo_finalize_funcs;

end.
